home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / HTMLVIEW / HTMLVIEW.ZIP / DEMOSRC.ZIP / DEMOUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-05  |  7.9 KB  |  308 lines
  1. unit Demounit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, HtmlSubs, FontDlg,
  8.   htmlabt;
  9.  
  10. const
  11.   MaxHistories = 6;  {size of History list}
  12. type
  13.   TForm1 = class(TForm)
  14.     OpenDialog: TOpenDialog;
  15.     MainMenu: TMainMenu;
  16.     Panel1: TPanel;
  17.     Panel2: TPanel;
  18.     Panel3: TPanel;
  19.     Viewer: THTMLViewer;
  20.     File1: TMenuItem;
  21.     Open: TMenuItem;
  22.     options1: TMenuItem;
  23.     ShowImages: TMenuItem;
  24.     Fonts: TMenuItem;
  25.     Edit1: TEdit;
  26.     Reload: TButton;
  27.     BackButton: TButton;
  28.     FwdButton: TButton;
  29.     HistoryMenuItem: TMenuItem;
  30.     Exit: TMenuItem;
  31.     N1: TMenuItem;
  32.     Print1: TMenuItem;
  33.     PrintDialog: TPrintDialog;
  34.     About1: TMenuItem;
  35.     procedure OpenFileClick(Sender: TObject);
  36.     procedure HotSpotChange(Sender: TObject; const URL: string);
  37.     procedure HotSpotClick(Sender: TObject; const URL: string;
  38.               var Handled: boolean);
  39.     procedure ShowImagesClick(Sender: TObject);
  40.     procedure ReloadClick(Sender: TObject);
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure FwdBackClick(Sender: TObject);
  44.     procedure HistoryClick(Sender: TObject);
  45.     procedure HistoryChange(Sender: TObject);
  46.     procedure ExitClick(Sender: TObject);
  47.     procedure FontColorsClick(Sender: TObject);
  48.     procedure Print1Click(Sender: TObject);
  49.     procedure About1Click(Sender: TObject);
  50.     procedure FormShow(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.     SndHandle : THandle;
  54.     PlaySound : function (lpszSoundName: PChar; uFlags: Word): Bool;
  55.     Histories: array[0..MaxHistories-1] of TMenuItem;
  56.     procedure FontChange(Sender: TObject);
  57.   public
  58.     { Public declarations }
  59.   end;
  60.  
  61. var
  62.   Form1: TForm1;
  63.  
  64. implementation
  65.  
  66. {$R *.DFM}
  67.  
  68. procedure TForm1.FormCreate(Sender: TObject);
  69. var
  70.   I: integer;
  71. begin
  72. OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  73.  
  74. {make sure mmsystem.dll exists before calling sndPlaySound}
  75. SndHandle := LoadLibrary('mmsystem.dll');
  76. if SndHandle >= 32 then
  77.   @PlaySound := GetProcAddress(SndHandle, 'sndPlaySound');
  78.  
  79. Viewer.HistoryMaxCount := MaxHistories;  {defines size of history list}
  80.  
  81. for I := 0 to MaxHistories-1 do
  82.   begin      {create the MenuItems for the history list}
  83.   Histories[I] := TMenuItem.Create(HistoryMenuItem);
  84.   HistoryMenuItem.Insert(I, Histories[I]);
  85.   with Histories[I] do
  86.     begin
  87.     Visible := False;
  88.     OnClick := HistoryClick;
  89.     Tag := I;
  90.     end;
  91.   end;
  92. end;
  93.  
  94. procedure TForm1.FormShow(Sender: TObject);
  95. begin
  96. if (ParamCount >= 1) then
  97.   Viewer.LoadFromFile(ParamStr(1));  {Parameter is file to load}
  98. end;
  99.  
  100. procedure TForm1.FormDestroy(Sender: TObject);
  101. begin
  102. if SndHandle >= 32 then FreeLibrary(SndHandle);
  103. end;
  104.  
  105. procedure TForm1.OpenFileClick(Sender: TObject);
  106. begin
  107. if Viewer.CurrentFile <> '' then
  108.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  109. if OpenDialog.Execute then
  110.   begin
  111.   Viewer.LoadFromFile(OpenDialog.Filename);
  112.   Caption := Viewer.DocumentTitle;
  113.   Reload.Enabled := Viewer.CurrentFile <> '';
  114.   Print1.Enabled := Viewer.CurrentFile <> '';
  115.   end;
  116. end;
  117.  
  118. procedure TForm1.HotSpotChange(Sender: TObject; const URL: string);
  119. {mouse moved over or away from a hot spot.  Change the status line}
  120. begin
  121. Panel1.Caption := URL;
  122. end;
  123.  
  124. procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
  125.           var Handled: boolean);
  126. {This routine handles what happens when a hot spot is clicked.  The assumption
  127.  is made that DOS filenames are being used. .EXE and .WAV files are handled
  128.  here, but other file types could be easily added.
  129.  
  130.  If the URL is handled here, set Handled to True.  If not handled here, set it
  131.  to False and ThtmlViewer will handle it.}
  132. const
  133.   snd_Async = $0001;  { play asynchronously }
  134. var
  135.   PC: array[0..255] of char;
  136.   S, Params: string[80];
  137.   Ext: string[5];
  138.   I, J, K: integer;
  139.  
  140. begin
  141. Handled := False;
  142. I := Pos(':', URL);
  143. J := Pos('FILE:', UpperCase(URL));
  144. if (I <= 2) or (J > 0) then
  145.   begin                      {apparently the URL is a filename}
  146.   S := URL;
  147.   K := Pos(' ', S);
  148.   if K > 0 then
  149.     begin
  150.     Params := Copy(S, K, 255);   {save any parameters}
  151.     S[0] := chr(K-1);            {truncate S}
  152.     end
  153.   else Params := '';
  154.   S := Viewer.HTMLExpandFileName(S);
  155.   Ext := Uppercase(ExtractFileExt(S));
  156.   if Ext = '.WAV' then
  157.     begin
  158.     Handled := True;
  159.     if Assigned(PlaySound) then
  160.       PlaySound(StrPCopy(PC, S), snd_ASync);
  161.     end
  162.   else if Ext = '.EXE' then
  163.     begin
  164.     Handled := True;
  165.     WinExec(StrPCopy(PC, S+Params), sw_Show);
  166.     end;
  167.   {else ignore other extensions}
  168.   Edit1.Text := URL;
  169.   end
  170. else Edit1.Text := URL;   {other protocall, mailto:, ftp:, etc.}
  171. end;
  172.  
  173. procedure TForm1.ShowImagesClick(Sender: TObject);
  174. {The Show Images menu item was clicked}
  175. begin
  176. With Viewer do
  177.   begin
  178.   ViewImages := not ViewImages;
  179.   (Sender as TMenuItem).Checked := ViewImages;
  180.   end;
  181. end;
  182.  
  183. procedure TForm1.ReloadClick(Sender: TObject);
  184. {the Reload button was clicked}
  185. var
  186.   Pos: LongInt;
  187. begin
  188. with Viewer do
  189.   begin
  190.   Pos := Position;     {save the postion}
  191.   LoadFromFile(CurrentFile);   {load again}
  192.   Position := Pos;     {restore position}
  193.   end;
  194. end;
  195.  
  196. procedure TForm1.FwdBackClick(Sender: TObject);
  197. {Either the Forward or Back button was clicked}
  198. begin
  199. with Viewer do
  200.   begin
  201.   if Sender = BackButton then
  202.     HistoryIndex := HistoryIndex +1
  203.   else
  204.     HistoryIndex := HistoryIndex -1;
  205.   end;
  206. end;
  207.  
  208. procedure TForm1.HistoryChange(Sender: TObject);
  209. {This event occurs when something changes history list}
  210. var
  211.   I: integer;
  212. begin
  213. with Sender as ThtmlViewer do
  214.   begin
  215.   {check to see which buttons are to be enabled}
  216.   FwdButton.Enabled := HistoryIndex > 0;
  217.   BackButton.Enabled := HistoryIndex < History.Count-1;
  218.  
  219.   {Enable and caption the appropriate history menuitems}
  220.   HistoryMenuItem.Visible := History.Count > 0;
  221.   for I := 0 to MaxHistories-1 do
  222.     with Histories[I] do
  223.       if I < History.Count then
  224.         Begin
  225.         Caption := History.Strings[I];
  226.         Visible := True;
  227.         Checked := I = HistoryIndex;
  228.         end
  229.       else Histories[I].Visible := False; 
  230.   Caption := DocumentTitle;    {keep the caption updated}
  231.   end;
  232. end;
  233.  
  234. procedure TForm1.HistoryClick(Sender: TObject);
  235. {A history list menuitem got clicked on}
  236. begin
  237.   {Changing the HistoryIndex loads and positions the appropriate document}
  238.   Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
  239. end;
  240.  
  241. procedure TForm1.ExitClick(Sender: TObject);
  242. begin
  243. Close;
  244. end;
  245.  
  246. procedure TForm1.FontChange(Sender: TObject);
  247. begin
  248. with FontForm do
  249.   begin
  250.   Viewer.DefFontName := FontName;
  251.   Viewer.DefFontColor := FontColor;
  252.   Viewer.DefHotSpotColor := HotSpotColor;
  253.   Viewer.DefBackground := Background;
  254.   end;
  255. end;
  256.  
  257. procedure TForm1.FontColorsClick(Sender: TObject);
  258. var
  259.   I: Integer;
  260.   FontForm: TFontForm;
  261. begin
  262. try
  263.   FontForm := TFontForm.Create(Self);
  264.   with FontForm do
  265.     begin
  266.     FontName := Viewer.DefFontName;
  267.     FontColor := Viewer.DefFontColor;
  268.     FontSize := Viewer.DefFontSize;
  269.     HotSpotColor := Viewer.DefHotSpotColor;
  270.     Background := Viewer.DefBackground;
  271.     if ShowModal = mrOK then
  272.       begin
  273.       Viewer.DefFontName := FontName;
  274.       Viewer.DefFontColor := FontColor;
  275.       Viewer.DefFontSize := FontSize;
  276.       Viewer.DefHotSpotColor := HotSpotColor;
  277.       Viewer.DefBackground := Background;
  278.       ReloadClick(Self);    {reload to see how it looks}
  279.       end;
  280.     end;
  281. finally
  282.   FontForm.Free;
  283.  end;
  284. end;
  285.  
  286. procedure TForm1.Print1Click(Sender: TObject);
  287. begin
  288. with PrintDialog do
  289.   if Execute then
  290.     if PrintRange = prAllPages then
  291.       viewer.Print(1, 9999)
  292.     else
  293.       Viewer.Print(FromPage, ToPage);
  294. end;
  295.  
  296. procedure TForm1.About1Click(Sender: TObject);
  297. begin
  298. try
  299.   AboutBox := TAboutBox.Create(Self);
  300.   AboutBox.ShowModal;
  301. finally
  302.   AboutBox.Free;
  303.   end;
  304. end;
  305.  
  306.  
  307. end.
  308.